home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 5 / Apprentice-Release5.iso / Environments / PowerMacOberon feb96 / Source / Packager.Mod (.txt) < prev    next >
Encoding:
Oberon Text  |  1995-02-10  |  15.5 KB  |  368 lines  |  [TEXT/.Ob4]
  1. Syntax10.Scn.Fnt
  2. Syntax10b.Scn.Fnt
  3. InfoElems
  4. Alloc
  5. Syntax10.Scn.Fnt
  6. StampElems
  7. Alloc
  8. 10 Feb 95
  9. FoldElems
  10. Syntax10.Scn.Fnt
  11. static Module Modules_ThisMod(CHAR *name, LONGINT length) {
  12.     CHAR fname[128];
  13.     Module m;
  14.     long len;
  15.     LONGINT lens[128];
  16.     LONGINT offset, oldpos; 
  17.     INTEGER i, ObjFile, nofEntries; 
  18.     CHAR name[40];
  19.     *res = done;
  20.     strcpy (importing, name);
  21.     m = FindModule(name);
  22.     if (m == NULL) {
  23.         strcpy(fname, name); strcat(fname, ".Obj");
  24.         ObjFile = FindFile(fname);
  25.         if (*res == done) {
  26.             GetEOF (ObjFile, &len); if (len > 100000) len = 100000;
  27.             FSRead(ObjFile, &len, objfile); pos = 0;
  28.             if (objfile[0] == '\xF8') {
  29.                 FSClose(ObjFile);
  30.                 m = LoadModule();
  31.             else if (objfile[0] == '\xF9') {
  32.                 Check('\xF9'); Check('1');
  33.                 Read2(&nofEntries);
  34.                 for (i = 0; i < nofEntries; i ++) {
  35.                     ReadName(name); Read4(&lens[i]); Read4(&offset);
  36.                 }
  37.                 oldpos = pos;
  38.                 for (i = 0; i < nofEntries; i ++) {
  39.                     SetFPos(ObjFile, 1, oldpos); oldpos += lens[i];
  40.                     FSRead(ObjFile, &lens[i], objfile); pos = 0;
  41.                     m = LoadModule();
  42.                 }
  43.             } 
  44.     return m;
  45. "Title": Packager.Mod
  46. "Author": Christoph Steindl (CS)
  47. "Abstract": The packager takes a list of modules and puts them into one package which can
  48.     be loaded at once. The modules presented have to be in the right dependency order, i.e.
  49.     the module imported by the most modules must be first and the top-most module, usually
  50.     the user interface module with commands, must be the last module.
  51.     The loader is modified so that it can load whole packages (i.e. top-most modules with all
  52.     their imported modules) instead of (recursively) loading all the imported modules.
  53. "Keywords": object file format, package, loader
  54. "Version": 1
  55. "From":  11.01.95 10:59:04
  56. "Until": 
  57. "Changes": The procedure ThisMod in the loader (oberon.c) has been adapted 
  58. adapted Modules_ThisMod
  59. "Hints": Package = [Table] {ObjFile}.
  60.     Table = 0F9X "1" nofEntries2 {Name Len4 Offset4}.
  61. Syntax10i.Scn.Fnt
  62. StampElems
  63. Alloc
  64. 10 Feb 95
  65. FoldElems
  66. Syntax10.Scn.Fnt
  67. = RECORD
  68.         name: POINTER TO ARRAY OF CHAR;
  69.         len, offset: LONGINT
  70.     END;
  71. Syntax10.Scn.Fnt
  72. = RECORD 
  73.         entry: Entry;    
  74.         next: QueueElement;
  75.     END; 
  76. Syntax10.Scn.Fnt
  77. = RECORD
  78.         n: INTEGER;
  79.         head, tail: QueueElement;
  80.     END;
  81. Syntax8i.Scn.Fnt
  82. Syntax10.Scn.Fnt
  83. FoldElems
  84. Syntax10.Scn.Fnt
  85. BEGIN
  86.     NEW(q.head); q.n := 0; q.tail := q.head;
  87. END InitFIFOQueue;
  88. Syntax10.Scn.Fnt
  89. BEGIN
  90.     NEW(q.tail.next); q.tail.next.entry := e; q.tail := q.tail.next; INC(q.n);
  91. END Enqueue;
  92. Syntax10.Scn.Fnt
  93. BEGIN
  94.     IF q.head # q.tail THEN
  95.         q.head := q.head.next; DEC(q.n);
  96.         RETURN q.head.entry
  97.     ELSE RETURN NIL END
  98. END Dequeue;
  99. Syntax10.Scn.Fnt
  100.     BEGIN RETURN q.head = q.tail END Empty;
  101. Syntax10.Scn.Fnt
  102.     BEGIN IF q.head # q.tail THEN RETURN q.head.next ELSE RETURN NIL END END First;
  103. Syntax10.Scn.Fnt
  104.     BEGIN IF (this # q.tail) THEN RETURN this.next ELSE RETURN NIL END END Next;
  105. PROCEDURE InitFIFOQueue (q: FIFOQueue);
  106. PROCEDURE (q: FIFOQueue) Enqueue (e: Entry);
  107. PROCEDURE (q: FIFOQueue) Dequeue (): Entry;
  108. PROCEDURE (q: FIFOQueue) Empty (): BOOLEAN;
  109. PROCEDURE (VAR q: FIFOQueueDesc) First (): QueueElement;
  110. PROCEDURE (VAR q: FIFOQueueDesc) Next (this: QueueElement): QueueElement;
  111. Syntax10.Scn.Fnt
  112. FoldElems
  113. Syntax10.Scn.Fnt
  114.     VAR i: INTEGER;
  115. BEGIN
  116.     i := 0; WHILE n[i] # 0X DO INC(i) END; NEW(e.name, i + 1); COPY(n, e.name^)
  117. END SetName;
  118. Syntax10.Scn.Fnt
  119.     VAR i: INTEGER;
  120. BEGIN
  121.     i := 0; WHILE (n[i] # 0X) & (n[i] # ".") DO INC(i) END;
  122.     n[i] := "."; n[i + 1] := "O"; n[i + 2] := "b"; n[i + 3] := "j"; n[i + 4] := 0X;
  123. END AppendObj;
  124. Syntax10.Scn.Fnt
  125.     VAR i: INTEGER;
  126. BEGIN
  127.     i := 0; WHILE (n[i] # 0X) & (n[i] # ".") DO INC(i) END; n[i] := 0X;
  128. END SkipObj;
  129. PROCEDURE (VAR e: EntryDesc) SetName (VAR n: ARRAY OF CHAR);
  130. PROCEDURE AppendObj (VAR n: ARRAY OF CHAR);
  131. PROCEDURE SkipObj (VAR n: ARRAY OF CHAR);
  132. Syntax8i.Scn.Fnt
  133. Syntax10.Scn.Fnt
  134. FoldElems
  135. Syntax10.Scn.Fnt
  136.     TYPE B2 = ARRAY 2 OF CHAR;
  137.     VAR c: B2;
  138. BEGIN
  139.     c := SYSTEM.VAL(B2, x); Files.WriteBytes(R, c, 2)
  140. END WriteInt;
  141. Syntax10.Scn.Fnt
  142.     TYPE B4 = ARRAY 4 OF CHAR;
  143.     VAR c: B4;
  144. BEGIN
  145.     c := SYSTEM.VAL(B4, x); Files.WriteBytes(R, c, 4)
  146. END WriteLInt;
  147. Syntax10.Scn.Fnt
  148.     VAR b: ARRAY 2 OF CHAR;
  149. BEGIN    
  150.     Files.ReadBytes(R, b, 2); x := SYSTEM.VAL(INTEGER, b)
  151. END ReadInt;
  152. Syntax10.Scn.Fnt
  153.     VAR b: ARRAY 4 OF CHAR;
  154. BEGIN
  155.     Files.ReadBytes(R, b, 4); x:=SYSTEM.VAL(LONGINT, b)
  156. END ReadLInt;
  157. (* In order to obtain the expected byte-ordering we have to bypass Files.WriteInt and Files.WriteLInt which would
  158.     invert the byte-ordering. Data files are stored in little endian format, the PowerPC is a big endian machine, the 
  159.     compiler generates code for a big endian machine and the loader which reads the packages expects big endian
  160.     data. *)
  161. PROCEDURE WriteInt (VAR R: Files.Rider; x: INTEGER);
  162. PROCEDURE WriteLInt (VAR R: Files.Rider; x: LONGINT);
  163. PROCEDURE ReadInt (VAR R: Files.Rider; VAR x: INTEGER);
  164. PROCEDURE ReadLInt (VAR R: Files.Rider; VAR x: LONGINT);
  165. Syntax10b.Scn.Fnt
  166. Syntax8i.Scn.Fnt
  167. FoldElems
  168. Syntax8i.Scn.Fnt
  169. Syntax10.Scn.Fnt
  170.     VAR ch: CHAR;
  171. BEGIN
  172.     f := Files.Old(package); IF f = NIL THEN RETURN FALSE END;
  173.     Files.Set(r, f, 0);
  174.     Files.Read(r, ch); IF ch # 0F9X THEN RETURN FALSE END;
  175.     Files.Read(r, ch); IF ch # "1" THEN RETURN FALSE END;
  176.     RETURN TRUE
  177. END OpenPackage;
  178. Syntax10.Scn.Fnt
  179. Syntax8i.Scn.Fnt
  180. Syntax10.Scn.Fnt
  181. BEGIN
  182.     fdst := Files.New("Package"); Files.Set(rdst, fdst, 0);
  183.     Files.Write(rdst, 0F9X); Files.Write(rdst, "1");
  184.     currPos := 2; (* position of the rider = number of bytes written *)
  185. END CreatePackage;
  186. Syntax10.Scn.Fnt
  187. BEGIN
  188.     Files.Register(f);
  189.     Files.Rename("Package", package, res);
  190. END ClosePackage;
  191. PROCEDURE OpenPackage (VAR package: ARRAY OF CHAR; VAR f: Files.File; VAR r: Files.Rider): BOOLEAN;
  192.     (*Opens the package, reads the tag and the version byte and returns TRUE if successful, otherwise FALSE; the global variables r 
  193.     and f are set.*)
  194. PROCEDURE CreatePackage (VAR fdst: Files.File; VAR rdst: Files.Rider; VAR currPos: LONGINT);
  195.     (*Creates the package "Package", writes the tag and version byte and sets currPos to the position of the rider.*)
  196. PROCEDURE ClosePackage(f: Files.File; VAR package: ARRAY OF CHAR; VAR res: INTEGER);
  197.     (*Registers the package and renames it to the parameter "package", res is the return-value of the Rename-call.*)
  198. Syntax10b.Scn.Fnt
  199. Syntax8i.Scn.Fnt
  200. FoldElems
  201. Syntax10.Scn.Fnt
  202.     VAR fsrc, fdst: Files.File; rsrc, rdst: Files.Rider; nofEntries, res: INTEGER; currPos: LONGINT;
  203.         module: ModuleName; e: Entry; qelem: QueueElement; entries: FIFOQueue;
  204.         buf: POINTER TO ARRAY OF CHAR;
  205. BEGIN
  206.     In.Open; In.Name(module); SkipObj(module);
  207.     NEW(entries); InitFIFOQueue(entries); 
  208.     CreatePackage(fdst, rdst, currPos); nofEntries := 0; currPos := currPos + 2; (* for nofEntries *)
  209.     WHILE In.Done DO
  210.         NEW(e); INC(nofEntries);
  211.         e.SetName(module); AppendObj(module); fsrc := Files.Old(module);
  212.         IF fsrc = NIL THEN done := FALSE; RETURN END;
  213.         entries.Enqueue(e); e.len := Files.Length(fsrc);
  214.         currPos := currPos + LEN(e.name^) + 8;
  215.         In.Name(module); SkipObj(module);
  216.     END;
  217.     WriteInt(rdst, nofEntries);
  218.     qelem := entries.First();
  219.     WHILE qelem # NIL DO
  220.         Files.WriteString(rdst, qelem.entry.name^); WriteLInt(rdst, qelem.entry.len); 
  221.         WriteLInt(rdst, currPos); currPos := currPos + qelem.entry.len;
  222.         qelem := entries.Next(qelem);
  223.     END;
  224.     WHILE ~entries.Empty() DO
  225.         e := entries.Dequeue();
  226.         COPY(e.name^, module); AppendObj(module);
  227.         fsrc := Files.Old(module); Files.Set(rsrc, fsrc, 0); 
  228.         NEW(buf, e.len); Files.ReadBytes(rsrc, buf^, e.len); Files.WriteBytes(rdst, buf^, e.len);
  229.     END;
  230.     ClosePackage(fdst, module, res);
  231.     done := res = 0
  232. END Compose;
  233. Syntax10.Scn.Fnt
  234. Syntax10.Scn.Fnt
  235. Syntax10i.Scn.Fnt
  236.     VAR inPackage: BOOLEAN; extract, module, package, newPackage: ModuleName;
  237.         i, extrI, nofEntries, res: INTEGER; fsrc, fdst: Files.File; rsrc, rdst: Files.Rider;
  238.         currPos, extrOffset, extrLen, len, copyLen, offset, pos1, pos2: LONGINT;
  239.         buf: POINTER TO ARRAY OF CHAR;
  240. BEGIN
  241.     In.Open; In.Name(extract); SkipObj(extract); In.Name(package); AppendObj(package);
  242.     In.Name(newPackage); AppendObj(newPackage);
  243.     IF ~OpenPackage(package, fsrc, rsrc) THEN done := FALSE; RETURN END;
  244.     ReadInt(rsrc, nofEntries); inPackage := FALSE; extrI := 1;
  245.     WHILE ~inPackage & (extrI <= nofEntries) DO
  246.         pos1 := Files.Pos(rsrc);
  247.         Files.ReadString(rsrc, module); ReadLInt(rsrc, extrLen); ReadLInt(rsrc, extrOffset);
  248.         pos2 := Files.Pos(rsrc);
  249.         IF module = extract THEN inPackage := TRUE ELSE INC(extrI) END
  250.     END;
  251.     IF inPackage THEN (* pos1 is the position of the rider previous to the entry of the module to be extracted,
  252.                                   pos2 is the position of the rider after the entry,
  253.                                   extrI is the index of the module to be extracted.*)
  254.         CreatePackage(fdst, rdst, currPos); 
  255.         WriteInt(rdst, nofEntries - 1); currPos := currPos + 2; i := 1;
  256.         Files.Set(rsrc, fsrc, currPos);
  257.         WHILE i <= nofEntries DO
  258.             Files.ReadString(rsrc, module); ReadLInt(rsrc, len); ReadLInt(rsrc, offset);
  259.             IF i # extrI THEN Files.WriteString(rdst, module); WriteLInt(rdst, len) END;
  260.             IF i < extrI THEN 
  261.                 WriteLInt(rdst, offset - (pos2 - pos1))
  262.             ELSIF i > extrI THEN
  263.                 WriteLInt(rdst, offset - (pos2 - pos1) - extrLen)
  264.             END;
  265.             INC(i)
  266.         END;
  267.         copyLen := extrOffset - Files.Pos(rsrc);
  268.         IF copyLen > 0 THEN (* copyLen = 0 when extracting the first module *)
  269.             NEW(buf, copyLen); 
  270.             Files.ReadBytes(rsrc, buf^, copyLen); Files.WriteBytes(rdst, buf^, copyLen)
  271.         END;
  272.         Files.Set(rsrc, fsrc, extrOffset + extrLen);
  273.         copyLen := Files.Length(fsrc) - extrOffset - extrLen; 
  274.         IF copyLen > 0 THEN (* copyLen = 0 when extracting the last module *)
  275.             NEW(buf, copyLen);
  276.             Files.ReadBytes(rsrc, buf^, copyLen); Files.WriteBytes(rdst, buf^, copyLen)
  277.         END;
  278.         ClosePackage(fdst, newPackage, res);
  279.         AppendObj(extract); fdst := Files.New(extract); Files.Set(rdst, fdst, 0); Files.Set(rsrc, fsrc, extrOffset);
  280.         NEW(buf, extrLen); Files.ReadBytes(rsrc, buf^, extrLen); Files.WriteBytes(rdst, buf^, extrLen);
  281.         Files.Register(fdst)    
  282.     END;
  283.     done := (res = 0) & inPackage
  284. END Extract;
  285. Syntax10.Scn.Fnt
  286.     VAR entry: Entry; entries: FIFOQueue; nofEntries, i: INTEGER; package, module: ModuleName;
  287.         fsrc, fdst: Files.File; rsrc, rdst: Files.Rider; buf: POINTER TO ARRAY OF CHAR;
  288. BEGIN
  289.     In.Open; In.Name(package); AppendObj(package);
  290.     IF ~OpenPackage(package, fsrc, rsrc) THEN done := FALSE; RETURN END;
  291.     NEW(entries); InitFIFOQueue(entries);
  292.     ReadInt(rsrc, nofEntries);
  293.     FOR i := 1 TO nofEntries DO
  294.         Files.ReadString(rsrc, module);
  295.         NEW(entry); entries.Enqueue(entry);
  296.         entry.SetName(module); ReadLInt(rsrc, entry.len); ReadLInt(rsrc, entry.offset);
  297.     END;
  298.     WHILE ~entries.Empty() DO
  299.         entry := entries.Dequeue();
  300.         COPY(entry.name^, module); AppendObj(module);
  301.         fdst := Files.New(module); Files.Set(rdst, fdst, 0); NEW(buf, entry.len);
  302.         Files.ReadBytes(rsrc, buf^, entry.len); Files.WriteBytes(rdst, buf^, entry.len);
  303.         Files.Register(fdst);
  304.     END;
  305.     done := TRUE
  306. END Decompose;
  307. Syntax10.Scn.Fnt
  308.     VAR package, module: ModuleName; nofEntries, i: INTEGER; len, offset: LONGINT;
  309.         fsrc: Files.File; rsrc: Files.Rider;
  310. BEGIN
  311.     In.Open; In.Name(package); AppendObj(package);
  312.     Out.Ln; Out.String(package);
  313.     IF ~OpenPackage(package, fsrc, rsrc) THEN Out.String(" is no package."); done := FALSE; RETURN END;
  314.     ReadInt(rsrc, nofEntries);
  315.     Out.String(" contains "); Out.Int(nofEntries, 0); Out.String(" entries."); Out.Ln;
  316.     FOR i := 1 TO nofEntries DO
  317.         Files.ReadString(rsrc, module); ReadLInt(rsrc, len); ReadLInt(rsrc, offset);
  318.         Out.String(module); Out.String(", length: "); Out.Int(len, 0); Out.String(", offset: "); Out.Int(offset, 0); Out.Ln;
  319.     END;
  320.     done := TRUE
  321. END List;
  322. PROCEDURE Compose*;
  323.     (**"Packager.Compose {obj}" creates a package out of a list of object files. The names of the object files can either have 
  324.     the extension .Mod, .Obj or no extension. The object files must be in the order as they are imported by each other with 
  325.     the top-most (user-interface-module with commands) module at the end (like the compile order determined by 
  326.     Make.Order). The package gets the name of the last object module.*)
  327. PROCEDURE Extract*;
  328.     (**"Packager.Extract extr oldPack newPack" extracts the module "extr" from the package "oldPack" and creates the standalone 
  329.     object file extr and the new package "newPack" (same as oldPack but without module extr).*)
  330. PROCEDURE Decompose*;
  331.     (**"Packager.Decompose pack" decomposes the package "pack" into its source object files. Normally the package is deleted 
  332.     because when the last module is extracted and created, it has the same name as the module and thus overwrites the 
  333.     previously existing package.*)
  334. PROCEDURE List*;
  335.     (**"Packager.List pack" lists the object files in the package "pack" with their lengths and offsets within the package.*)
  336. Syntax10.Scn.Fnt
  337. Folds.Compile A.Mod    AA.Mod    B.Mod    BB.Mod    ABB.Mod ~
  338. Make.Order ^
  339. Packager.Compose ^ A AA ~    A    AA    B    BB    ABB ~    A ~    B    BB ~    A    AA    BB ABB ~
  340. System.Directory ^ A*.Obj/ds    System.Directory B*.Obj/ds     New*.Obj/ds
  341. Packager.List ^
  342. Packager.Extract ^ A AA B ~    BB    ABB    NewABB ~ A A B ~
  343. Packager.Decompose ^ AA    ABB    A
  344. ABB.Do    A.Do
  345. Test.Mod    Test.Do
  346. Hex.Open ^ A.Obj    AA.Obj    B.Obj    BB.Obj    ABB.Obj
  347. MODULE Packager;    
  348.     (**Christoph Steindl (CS), from 11.01.95 until 
  349. IMPORT In, Out, Files, SYSTEM;
  350. (**    Package file format (simple extension to the PowerPC object file format):
  351.     Package = [Table] {ObjFile}.
  352.     Table = 0F9X "1" nofEntries2 {Name Len4 Offset4}.
  353.     ModuleName = ARRAY 37 OF CHAR;
  354.     Entry = POINTER TO EntryDesc;
  355.     EntryDesc 
  356.     FIFOQueue = POINTER TO FIFOQueueDesc;
  357.     QueueElement = POINTER TO QueueElementDesc;
  358.     QueueElementDesc 
  359.     FIFOQueueDesc 
  360.     done*: BOOLEAN;    (** TRUE on success *)
  361. FIFOQueue handling
  362. Entry.SetName, AppendObj and SkipObj
  363. WriteInt, WriteLInt, ReadInt and ReadLInt
  364. Opening, closing and creation of packages
  365. Commands: Compose, Decompose, List and Extract
  366. END Packager.
  367. For testing only
  368.